home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch9 / TweenSmo.frm < prev    next >
Text File  |  1999-05-29  |  25KB  |  911 lines

  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Begin VB.Form frmTweenSmo 
  4.    Caption         =   "TweenSmo"
  5.    ClientHeight    =   4590
  6.    ClientLeft      =   2040
  7.    ClientTop       =   1035
  8.    ClientWidth     =   4635
  9.    LinkTopic       =   "Form1"
  10.    PaletteMode     =   1  'UseZOrder
  11.    ScaleHeight     =   306
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   309
  14.    Begin VB.CommandButton cmdTween 
  15.       Caption         =   "Tween"
  16.       Height          =   495
  17.       Left            =   3480
  18.       TabIndex        =   12
  19.       Top             =   480
  20.       Width           =   975
  21.    End
  22.    Begin VB.TextBox txtNumTweens 
  23.       Height          =   285
  24.       Left            =   4200
  25.       TabIndex        =   10
  26.       Text            =   "4"
  27.       Top             =   0
  28.       Width           =   375
  29.    End
  30.    Begin VB.TextBox txtFramesPerSecond 
  31.       Height          =   285
  32.       Left            =   4200
  33.       TabIndex        =   9
  34.       Text            =   "20"
  35.       Top             =   1770
  36.       Width           =   375
  37.    End
  38.    Begin VB.CommandButton cmdPlay 
  39.       Caption         =   "Play"
  40.       Default         =   -1  'True
  41.       Height          =   495
  42.       Left            =   3480
  43.       TabIndex        =   7
  44.       Top             =   3480
  45.       Width           =   975
  46.    End
  47.    Begin VB.OptionButton optPlay 
  48.       Caption         =   "Reversing"
  49.       Height          =   255
  50.       Index           =   2
  51.       Left            =   3360
  52.       TabIndex        =   4
  53.       Top             =   3000
  54.       Width           =   1095
  55.    End
  56.    Begin VB.OptionButton optPlay 
  57.       Caption         =   "Looping"
  58.       Height          =   255
  59.       Index           =   1
  60.       Left            =   3360
  61.       TabIndex        =   3
  62.       Top             =   2640
  63.       Width           =   1095
  64.    End
  65.    Begin VB.OptionButton optPlay 
  66.       Caption         =   "Once"
  67.       Height          =   255
  68.       Index           =   0
  69.       Left            =   3360
  70.       TabIndex        =   2
  71.       Top             =   2280
  72.       Value           =   -1  'True
  73.       Width           =   1095
  74.    End
  75.    Begin VB.HScrollBar sbarFrame 
  76.       Height          =   255
  77.       Left            =   0
  78.       Max             =   1
  79.       Min             =   1
  80.       TabIndex        =   1
  81.       Top             =   3960
  82.       Value           =   1
  83.       Width           =   3255
  84.    End
  85.    Begin VB.PictureBox picCanvas 
  86.       Height          =   3975
  87.       Left            =   0
  88.       ScaleHeight     =   261
  89.       ScaleMode       =   3  'Pixel
  90.       ScaleWidth      =   213
  91.       TabIndex        =   0
  92.       Top             =   0
  93.       Width           =   3255
  94.    End
  95.    Begin MSComDlg.CommonDialog dlgFile 
  96.       Left            =   2640
  97.       Top             =   4200
  98.       _ExtentX        =   847
  99.       _ExtentY        =   847
  100.       _Version        =   393216
  101.       CancelError     =   -1  'True
  102.    End
  103.    Begin VB.Label Label1 
  104.       Caption         =   "Tweens:"
  105.       Height          =   255
  106.       Index           =   2
  107.       Left            =   3360
  108.       TabIndex        =   11
  109.       Top             =   0
  110.       Width           =   615
  111.    End
  112.    Begin VB.Label Label1 
  113.       Alignment       =   2  'Center
  114.       Caption         =   "Frames per Second"
  115.       Height          =   375
  116.       Index           =   1
  117.       Left            =   3360
  118.       TabIndex        =   8
  119.       Top             =   1680
  120.       Width           =   855
  121.    End
  122.    Begin VB.Label lblFrame 
  123.       Alignment       =   2  'Center
  124.       BorderStyle     =   1  'Fixed Single
  125.       Caption         =   "1/1"
  126.       Height          =   255
  127.       Left            =   1680
  128.       TabIndex        =   6
  129.       Top             =   4320
  130.       Width           =   735
  131.    End
  132.    Begin VB.Label Label1 
  133.       Caption         =   "Frame:"
  134.       Height          =   255
  135.       Index           =   0
  136.       Left            =   1080
  137.       TabIndex        =   5
  138.       Top             =   4320
  139.       Width           =   495
  140.    End
  141.    Begin VB.Menu mnuFile 
  142.       Caption         =   "&File"
  143.       Begin VB.Menu mnuFileOpen 
  144.          Caption         =   "&Open..."
  145.          Shortcut        =   ^O
  146.       End
  147.       Begin VB.Menu mnuFileSave 
  148.          Caption         =   "&Save"
  149.          Shortcut        =   ^S
  150.       End
  151.       Begin VB.Menu mnuFileSaveAs 
  152.          Caption         =   "Save &As..."
  153.          Shortcut        =   ^A
  154.       End
  155.       Begin VB.Menu mnuFileSep1 
  156.          Caption         =   "-"
  157.       End
  158.       Begin VB.Menu mnuFileNew 
  159.          Caption         =   "&New"
  160.          Shortcut        =   ^N
  161.       End
  162.       Begin VB.Menu mnuFileSep2 
  163.          Caption         =   "-"
  164.       End
  165.       Begin VB.Menu mnuFileExit 
  166.          Caption         =   "E&xit"
  167.       End
  168.    End
  169.    Begin VB.Menu mnuFrame 
  170.       Caption         =   "Frame"
  171.       Begin VB.Menu mnuFrameAfter 
  172.          Caption         =   "Insert &After"
  173.       End
  174.       Begin VB.Menu mnuFrameBefore 
  175.          Caption         =   "Insert &Before"
  176.       End
  177.       Begin VB.Menu mnuFrameSep 
  178.          Caption         =   "-"
  179.       End
  180.       Begin VB.Menu mnuFrameClear 
  181.          Caption         =   "&Clear"
  182.       End
  183.       Begin VB.Menu mnuFrameDelete 
  184.          Caption         =   "&Delete"
  185.          Enabled         =   0   'False
  186.       End
  187.    End
  188. End
  189. Attribute VB_Name = "frmTweenSmo"
  190. Attribute VB_GlobalNameSpace = False
  191. Attribute VB_Creatable = False
  192. Attribute VB_PredeclaredId = True
  193. Attribute VB_Exposed = False
  194. Option Explicit
  195.  
  196. Private NumFrames As Integer
  197. Private Frames() As PolylineFrame
  198. Private FileName As String
  199. Private FileTitle As String
  200. Private DataModified As Boolean
  201. Private Playing As Boolean
  202. Private NumPlayed As Long
  203. Private SelectedFrame As Integer
  204. Private SelectingFrame As Boolean
  205.  
  206. Private Drawing As Boolean
  207. Private StartX As Integer
  208. Private StartY As Integer
  209. Private LastX As Integer
  210. Private LastY As Integer
  211.  
  212. Private Type Polyline
  213.     NumPoints As Integer
  214.     X() As Integer
  215.     Y() As Integer
  216. End Type
  217.  
  218. Private Type PolylineFrame
  219.     NumPolylines As Integer
  220.     Poly() As Polyline
  221. End Type
  222. ' Insert a frame next to the selected one.
  223. Private Sub AddFrame()
  224. Dim i As Integer
  225.  
  226.     NumFrames = NumFrames + 1
  227.     ReDim Preserve Frames(1 To NumFrames)
  228.     For i = NumFrames - 1 To SelectedFrame Step -1
  229.         CopyFrame i, i + 1
  230.     Next i
  231.  
  232.     sbarFrame.Max = NumFrames
  233.  
  234.     mnuFrameDelete.Enabled = (NumFrames > 1)
  235.     DataModified = True
  236.     Caption = "TweenSmo*[" & FileTitle & "]"
  237. End Sub
  238.  
  239.  
  240. ' Copy a polyline from frame1 to frame2.
  241. Private Sub CopyFrame(frame1 As Integer, frame2 As Integer)
  242. Dim pline As Integer
  243. Dim point As Integer
  244.  
  245.     Frames(frame2).NumPolylines = Frames(frame1).NumPolylines
  246.     If Frames(frame2).NumPolylines < 1 Then
  247.         Erase Frames(frame2).Poly
  248.     Else
  249.         ReDim Frames(frame2).Poly(1 To Frames(frame2).NumPolylines)
  250.     End If
  251.     For pline = 1 To Frames(frame2).NumPolylines
  252.         With Frames(frame2).Poly(pline)
  253.             .NumPoints = Frames(frame1).Poly(pline).NumPoints
  254.             If .NumPoints < 1 Then
  255.                 Erase .X
  256.                 Erase .Y
  257.             Else
  258.                 ReDim .X(1 To .NumPoints)
  259.                 ReDim .Y(1 To .NumPoints)
  260.             End If
  261.             For point = 1 To .NumPoints
  262.                 .X(point) = Frames(frame1).Poly(pline).X(point)
  263.                 .Y(point) = Frames(frame1).Poly(pline).Y(point)
  264.             Next point
  265.         End With
  266.     Next pline
  267. End Sub
  268.  
  269. ' Return true if the data has not been modified,
  270. ' or the user has saved the changes, or the user
  271. ' wants to lose the changes.
  272. Private Function DataSafe() As Boolean
  273. Dim ans As Integer
  274.  
  275.     Do While DataModified
  276.         ans = MsgBox("The data has been modified." & _
  277.             " Do you want to save the changes?", _
  278.             vbYesNoCancel)
  279.         If ans = vbCancel Then Exit Do
  280.         If ans = vbNo Then
  281.             DataSafe = True
  282.             Exit Function
  283.         End If
  284.             
  285.         ' Otherwise save the data.
  286.         If FileName <> "" Then
  287.             mnuFileSave_Click
  288.         Else
  289.             mnuFileSaveAs_Click
  290.         End If
  291.     Loop
  292.     
  293.     DataSafe = Not DataModified
  294. End Function
  295.  
  296.  
  297. ' Draw the indicated frame.
  298. Private Sub DrawFrame(frame As Integer)
  299. Dim pline As Integer
  300. Dim point As Integer
  301.  
  302.     picCanvas.Cls
  303.  
  304.     For pline = 1 To Frames(frame).NumPolylines
  305.         With Frames(frame).Poly(pline)
  306.             If .NumPoints >= 2 Then
  307.                 picCanvas.Line (.X(1), .Y(1))-(.X(2), .Y(2))
  308.                 For point = 3 To .NumPoints
  309.                     picCanvas.Line -(.X(point), .Y(point))
  310.                 Next point
  311.             End If
  312.         End With
  313.     Next pline
  314. End Sub
  315.  
  316.  
  317. ' Save the data.
  318. Private Sub SaveData(ByVal file_name As String, ByVal file_title As String)
  319. Dim fnum As Integer
  320. Dim frame As Integer
  321. Dim pline As Integer
  322. Dim point As Integer
  323.  
  324.     On Error GoTo SaveDataError
  325.     ' Open the file.
  326.     fnum = FreeFile
  327.     Open file_name For Output As fnum
  328.     
  329.     ' Save the number of frames.
  330.     Write #fnum, NumFrames
  331.     
  332.     ' Save each frame.
  333.     For frame = 1 To NumFrames
  334.         With Frames(frame)
  335.             ' Save the number of polylines.
  336.             Write #fnum, .NumPolylines
  337.                     
  338.             ' Save each polyline.
  339.             For pline = 1 To .NumPolylines
  340.                 With .Poly(pline)
  341.                     ' Save the number of points.
  342.                     Write #fnum, .NumPoints
  343.                     For point = 1 To .NumPoints
  344.                         Write #fnum, .X(point), .Y(point)
  345.                     Next point
  346.                 End With
  347.             Next pline
  348.         End With
  349.     Next frame
  350.     Close fnum
  351.  
  352.     FileName = file_name
  353.     FileTitle = file_title
  354.     Caption = "TweenSmo [" & FileTitle & "]"
  355.     DataModified = False
  356.     Exit Sub
  357.     
  358. SaveDataError:
  359.     Beep
  360.     MsgBox "Error saving file " & file_name & "." & _
  361.         vbCrLf & Format$(Err.Number) & " : " & _
  362.         Err.Description
  363.     Exit Sub
  364. End Sub
  365.  
  366. ' Load polyline frames from the file.
  367. Private Sub LoadData(ByVal file_name As String, ByVal file_title As String)
  368. Dim fnum As Integer
  369. Dim frame As Integer
  370. Dim pline As Integer
  371. Dim point As Integer
  372.  
  373.     On Error GoTo SaveDataError
  374.     ' Open the file.
  375.     fnum = FreeFile
  376.     Open file_name For Input As fnum
  377.     
  378.     ' Read the number of frames.
  379.     Input #fnum, NumFrames
  380.     ReDim Frames(1 To NumFrames)
  381.     sbarFrame.Max = NumFrames
  382.     
  383.     ' Read each frame.
  384.     For frame = 1 To NumFrames
  385.         With Frames(frame)
  386.             ' Read the number of polylines.
  387.             Input #fnum, .NumPolylines
  388.             ReDim .Poly(1 To .NumPolylines)
  389.                     
  390.             ' Read each polyline.
  391.             For pline = 1 To .NumPolylines
  392.                 With .Poly(pline)
  393.                     ' Read the number of points.
  394.                     Input #fnum, .NumPoints
  395.                     ReDim .X(1 To .NumPoints)
  396.                     ReDim .Y(1 To .NumPoints)
  397.                     For point = 1 To .NumPoints
  398.                         Input #fnum, .X(point), .Y(point)
  399.                     Next point
  400.                 End With
  401.             Next pline
  402.         End With
  403.     Next frame
  404.     Close fnum
  405.     
  406.     SelectFrame 1
  407.     
  408.     FileName = file_name
  409.     FileTitle = file_title
  410.     Caption = "TweenSmo [" & FileTitle & "]"
  411.     DataModified = False
  412.     Exit Sub
  413.     
  414. SaveDataError:
  415.     Beep
  416.     MsgBox "Error loading file " & file_name & "." & _
  417.         vbCrLf & Format$(Err.Number) & " : " & _
  418.         Err.Description
  419.     Exit Sub
  420. End Sub
  421. ' Select and display the indicated frame.
  422. Private Sub SelectFrame(num As Integer)
  423.     SelectedFrame = num
  424.     
  425.     ' If we're drawing, stop drawing.
  426.     If Drawing Then
  427.         picCanvas.DrawMode = vbCopyPen
  428.         Drawing = False
  429.     End If
  430.     
  431.     DrawFrame SelectedFrame
  432.     
  433.     lblFrame.Caption = Format$(SelectedFrame) _
  434.          & "/" & Format$(NumFrames)
  435.     
  436.     SelectingFrame = True
  437.     sbarFrame.Value = SelectedFrame
  438.     SelectingFrame = False
  439. End Sub
  440.  
  441.  
  442. ' Create the tweens between two key frames using
  443. ' Hermite curves.
  444. Private Sub MakeTweens(ByVal key2 As Integer, ByVal key3 As Integer)
  445. Dim tween As Integer
  446. Dim pline As Integer
  447. Dim point As Integer
  448. Dim key1 As Integer
  449. Dim key4 As Integer
  450. Dim x1 As Integer
  451. Dim y1 As Integer
  452. Dim x2 As Integer
  453. Dim y2 As Integer
  454. Dim x3 As Integer
  455. Dim y3 As Integer
  456. Dim x4 As Integer
  457. Dim y4 As Integer
  458. Dim dx1 As Integer
  459. Dim dy1 As Integer
  460. Dim dx2 As Integer
  461. Dim dy2 As Integer
  462. Dim t As Single
  463. Dim t2 As Single
  464. Dim t3 As Single
  465. Dim A As Single
  466. Dim B As Single
  467. Dim C As Single
  468. Dim D As Single
  469.  
  470.     ' Make room for the points.
  471.     For tween = key2 + 1 To key3 - 1
  472.         Frames(tween).NumPolylines = Frames(key2).NumPolylines
  473.         ReDim Frames(tween).Poly(1 To Frames(tween).NumPolylines)
  474.         For pline = 1 To Frames(tween).NumPolylines
  475.             With Frames(tween).Poly(pline)
  476.                 .NumPoints = Frames(key2).Poly(pline).NumPoints
  477.                 ReDim .X(1 To .NumPoints)
  478.                 ReDim .Y(1 To .NumPoints)
  479.             End With
  480.         Next pline
  481.     Next tween
  482.     
  483.     ' For each endpoint, create the tween endpoints.
  484.     For pline = 1 To Frames(key2).NumPolylines
  485.         With Frames(key2).Poly(pline)
  486.             For point = 1 To .NumPoints
  487.                 ' Pick slopes for the start & end.
  488.                 If key2 > 1 Then
  489.                     key1 = key2 - (key3 - key2)
  490.                 Else
  491.                     key1 = key2
  492.                 End If
  493.                 x1 = Frames(key1).Poly(pline).X(point)
  494.                 y1 = Frames(key1).Poly(pline).Y(point)
  495.                 x2 = .X(point)
  496.                 y2 = .Y(point)
  497.                 x3 = Frames(key3).Poly(pline).X(point)
  498.                 y3 = Frames(key3).Poly(pline).Y(point)
  499.                 If key3 < NumFrames Then
  500.                     key4 = key3 + (key3 - key2)
  501.                 Else
  502.                     key4 = key3
  503.                 End If
  504.                 x4 = Frames(key4).Poly(pline).X(point)
  505.                 y4 = Frames(key4).Poly(pline).Y(point)
  506.                 dx1 = x3 - x1
  507.                 dy1 = y3 - y1
  508.                 dx2 = x4 - x2
  509.                 dy2 = y4 - y2
  510.                 ' Compute the Hermite values.
  511.                 For tween = key2 + 1 To key3 - 1
  512.                     t = (tween - key2) / (key3 - key2)
  513.                     t2 = t * t
  514.                     t3 = t * t2
  515.                     A = 2 * t3 - 3 * t2 + 1
  516.                     B = -2 * t3 + 3 * t2
  517.                     C = t3 - 2 * t2 + t
  518.                     D = t3 - t2
  519.                     Frames(tween).Poly(pline).X(point) = x2 * A + x3 * B + dx1 * C + dx2 * D
  520.                     Frames(tween).Poly(pline).Y(point) = y2 * A + y3 * B + dy1 * C + dy2 * D
  521.                 Next tween
  522.             Next point
  523.         End With
  524.     Next pline
  525. End Sub
  526.  
  527. Private Sub picCanvas_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  528.     If Drawing And Button = vbRightButton Then
  529.         ' End the previous polyline.
  530.         picCanvas.Line (StartX, StartY)-(LastX, LastY)
  531.         picCanvas.DrawMode = vbCopyPen
  532.         Drawing = False
  533.         Exit Sub
  534.     End If
  535.     
  536.     ' See if this is the start of a new polyline.
  537.     If Drawing Then
  538.         ' Nope. Erase the previous line.
  539.         picCanvas.Line (StartX, StartY)-(LastX, LastY)
  540.     Else
  541.         ' Start a new polyline.
  542.         With Frames(SelectedFrame)
  543.             .NumPolylines = .NumPolylines + 1
  544.             ReDim Preserve .Poly(1 To .NumPolylines)
  545.             With .Poly(.NumPolylines)
  546.                 .NumPoints = 1
  547.                 ReDim .X(1 To 1)
  548.                 ReDim .Y(1 To 1)
  549.                 .X(1) = X
  550.                 .Y(1) = Y
  551.             End With
  552.         End With
  553.         picCanvas.DrawMode = vbInvert
  554.         Drawing = True
  555.         DataModified = True
  556.         Caption = "TweenSmo*[" & FileTitle & "]"
  557.         StartX = X
  558.         StartY = Y
  559.     End If
  560.     
  561.     LastX = X
  562.     LastY = Y
  563.     picCanvas.Line (StartX, StartY)-(LastX, LastY)
  564. End Sub
  565. ' Repaint the current frame.
  566. Private Sub picCanvas_Paint()
  567.     If SelectingFrame Then Exit Sub
  568.     SelectFrame sbarFrame.Value
  569. End Sub
  570. Private Sub picCanvas_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  571.     If Not Drawing Then Exit Sub
  572.     
  573.     picCanvas.Line (StartX, StartY)-(LastX, LastY)
  574.     LastX = X
  575.     LastY = Y
  576.     picCanvas.Line (StartX, StartY)-(LastX, LastY)
  577. End Sub
  578.  
  579.  
  580. Private Sub picCanvas_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  581.     If Not Drawing Then Exit Sub
  582.     
  583.     picCanvas.Line (StartX, StartY)-(LastX, LastY)
  584.     picCanvas.DrawMode = vbCopyPen
  585.     picCanvas.Line (StartX, StartY)-(X, Y)
  586.     picCanvas.DrawMode = vbInvert
  587.  
  588.     With Frames(SelectedFrame)
  589.         With .Poly(.NumPolylines)
  590.             .NumPoints = .NumPoints + 1
  591.             ReDim Preserve .X(1 To .NumPoints)
  592.             ReDim Preserve .Y(1 To .NumPoints)
  593.             .X(.NumPoints) = X
  594.             .Y(.NumPoints) = Y
  595.         End With
  596.     End With
  597.  
  598.     DataModified = True
  599.     Caption = "TweenSmo*[" & FileTitle & "]"
  600.     StartX = X
  601.     StartY = Y
  602. End Sub
  603.  
  604. ' Play the animation.
  605. Private Sub cmdPlay_Click()
  606.     If Playing Then
  607.         Playing = False
  608.         cmdPlay.Caption = "Stopped"
  609.         cmdPlay.Enabled = False
  610.     Else
  611.         Playing = True
  612.         cmdPlay.Caption = "Stop"
  613.         PlayData
  614.         cmdPlay.Caption = "Play"
  615.         Playing = False
  616.         cmdPlay.Enabled = True
  617.         DrawFrame SelectedFrame
  618.     End If
  619. End Sub
  620.  
  621. ' Play the animation.
  622. Private Sub PlayData()
  623. Dim ms_per_frame As Long
  624. Dim start_time As Single
  625. Dim stop_time As Single
  626.  
  627.     ' See how fast we should go.
  628.     If Not IsNumeric(txtFramesPerSecond.Text) Then _
  629.         txtFramesPerSecond.Text = "10"
  630.     ms_per_frame = 1000 \ CLng(txtFramesPerSecond.Text)
  631.  
  632.     ' See what kind of animation this should be.
  633.     NumPlayed = 0
  634.     start_time = Timer
  635.     If optPlay(0).Value Then
  636.         PlayDataOnce ms_per_frame
  637.     ElseIf optPlay(1).Value Then
  638.         PlayDataLooping ms_per_frame
  639.     ElseIf optPlay(2).Value Then
  640.         PlayDataBackAndForth ms_per_frame
  641.     End If
  642.  
  643.     stop_time = Timer
  644.     MsgBox "Displayed" & Str$(NumPlayed) & _
  645.         " frames in " & _
  646.         Format$(stop_time - start_time, "0.00") & _
  647.         " seconds (" & _
  648.         Format$(NumPlayed / (stop_time - start_time), "0.00") & _
  649.         " FPS)."
  650. End Sub
  651. ' Play the animation once.
  652. Private Sub PlayDataOnce(ByVal ms_per_frame As Long)
  653. Dim frame As Integer
  654. Dim next_time As Long
  655.  
  656.     ' Start the animation.
  657.     next_time = GetTickCount()
  658.     For frame = 1 To NumFrames
  659.         If Not Playing Then Exit For
  660.         NumPlayed = NumPlayed + 1
  661.  
  662.         ' Draw the frame.
  663.         DrawFrame frame
  664.  
  665.         ' Wait until it's time for the next frame.
  666.         next_time = next_time + ms_per_frame
  667.         WaitTill next_time
  668.     Next frame
  669. End Sub
  670. ' Play the animation backwards.
  671. Private Sub PlayDataBackward(ByVal ms_per_frame As Long)
  672. Dim frame As Integer
  673. Dim next_time As Long
  674.  
  675.     ' Start the animation.
  676.     next_time = GetTickCount()
  677.     For frame = NumFrames To 1 Step -1
  678.         If Not Playing Then Exit For
  679.         NumPlayed = NumPlayed + 1
  680.  
  681.         ' Draw the frame.
  682.         DrawFrame frame
  683.  
  684.         ' Wait until it's time for the next frame.
  685.         next_time = next_time + ms_per_frame
  686.         WaitTill next_time
  687.     Next frame
  688. End Sub
  689. ' Play the animation in a loop.
  690. Private Sub PlayDataLooping(ByVal ms_per_frame As Long)
  691.     Do While Playing
  692.         PlayDataOnce ms_per_frame
  693.     Loop
  694. End Sub
  695. ' Play the animation back and forth.
  696. Private Sub PlayDataBackAndForth(ByVal ms_per_frame As Long)
  697.     Do While Playing
  698.         PlayDataOnce ms_per_frame
  699.         If Not Playing Then Exit Do
  700.         PlayDataBackward ms_per_frame
  701.     Loop
  702. End Sub
  703.  
  704. ' Make the tweens.
  705. Private Sub cmdTween_Click()
  706. Dim num_tweens As Integer
  707. Dim old_frames As Integer
  708. Dim frame1 As Integer
  709. Dim frame2 As Integer
  710. Dim frame As Integer
  711.  
  712.     ' See how many tweens to make.
  713.     If Not IsNumeric(txtNumTweens.Text) Then _
  714.         txtNumTweens.Text = "4"
  715.     num_tweens = txtNumTweens.Text
  716.     If num_tweens < 1 Then num_tweens = 1
  717.     
  718.     ' Make room for the new frames.
  719.     old_frames = NumFrames
  720.     NumFrames = num_tweens * (NumFrames - 1) + NumFrames
  721.     ReDim Preserve Frames(1 To NumFrames)
  722.     
  723.     ' Spread the original frames out.
  724.     For frame = old_frames To 2 Step -1
  725.         CopyFrame frame, _
  726.             num_tweens * (frame - 1) + frame
  727.     Next frame
  728.  
  729.     ' Make the tweens.
  730.     For frame = 1 To old_frames - 1
  731.         frame1 = num_tweens * (frame - 1) + frame
  732.         frame2 = frame1 + num_tweens + 1
  733.         MakeTweens frame1, frame2
  734.     Next frame
  735.  
  736.     sbarFrame.Max = NumFrames
  737.     SelectFrame num_tweens * (SelectedFrame - 1) + _
  738.         SelectedFrame
  739.     DataModified = True
  740.     Caption = "TweenSmo*[" & FileTitle & "]"
  741. End Sub
  742.  
  743.  
  744.  
  745. Private Sub Form_Load()
  746.     ' Position the scroll bar.
  747.     sbarFrame.Top = picCanvas.Top + picCanvas.Height + 1
  748.  
  749.     ' Create an empty frame.
  750.     mnuFileNew_Click
  751.  
  752.     dlgFile.InitDir = App.Path
  753.     dlgFile.Filter = _
  754.         "Tween Files (*.twe)|*.twe|" & _
  755.         "All Files (*.*)|*.*"
  756. End Sub
  757.  
  758. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  759.     Cancel = Not DataSafe()
  760. End Sub
  761.  
  762.  
  763. Private Sub Form_Unload(Cancel As Integer)
  764.     End
  765. End Sub
  766.  
  767. Private Sub mnuFileExit_Click()
  768.     Unload Me
  769. End Sub
  770.  
  771.  
  772. ' Load a data file.
  773. Private Sub mnuFileOpen_Click()
  774. Dim file_name As String
  775.  
  776.     If Not DataSafe() Then Exit Sub
  777.  
  778.     ' Allow the user to pick a file.
  779.     On Error Resume Next
  780.     dlgFile.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
  781.     dlgFile.ShowOpen
  782.     If Err.Number = cdlCancel Then
  783.         Exit Sub
  784.     ElseIf Err.Number <> 0 Then
  785.         Beep
  786.         MsgBox "Error selecting file.", , vbExclamation
  787.         Exit Sub
  788.     End If
  789.     On Error GoTo 0
  790.     
  791.     file_name = Trim$(dlgFile.FileName)
  792.     dlgFile.InitDir = Left$(file_name, Len(file_name) _
  793.         - Len(dlgFile.FileTitle) - 1)
  794.  
  795.     ' Load the data file.
  796.     LoadData file_name, dlgFile.FileTitle
  797.  
  798.     lblFrame.Caption = Format$(SelectedFrame) _
  799.          & "/" & Format$(NumFrames)
  800. End Sub
  801.  
  802. ' Clear out all the data.
  803. Private Sub mnuFileNew_Click()
  804.     If Not DataSafe() Then Exit Sub
  805.     
  806.     NumFrames = 1
  807.     ReDim Frames(1 To NumFrames)
  808.     Frames(1).NumPolylines = 0
  809.     sbarFrame.Max = NumFrames
  810.     SelectFrame 1
  811. End Sub
  812.  
  813. ' Save the data file.
  814. Private Sub mnuFileSave_Click()
  815.     If FileName = "" Then
  816.         mnuFileSaveAs_Click
  817.         Exit Sub
  818.     End If
  819.     
  820.     SaveData FileName, FileTitle
  821. End Sub
  822.  
  823. ' Save the data file with a new name.
  824. Private Sub mnuFileSaveAs_Click()
  825. Dim file_name As String
  826.  
  827.     ' Allow the user to pick a file.
  828.     On Error Resume Next
  829.     dlgFile.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly
  830.     dlgFile.ShowSave
  831.     If Err.Number = cdlCancel Then
  832.         Exit Sub
  833.     ElseIf Err.Number <> 0 Then
  834.         Beep
  835.         MsgBox "Error selecting file.", , vbExclamation
  836.         Exit Sub
  837.     End If
  838.     On Error GoTo 0
  839.  
  840.     file_name = Trim$(dlgFile.FileName)
  841.     dlgFile.InitDir = Left$(file_name, Len(file_name) _
  842.         - Len(dlgFile.FileTitle) - 1)
  843.  
  844.     ' Save the script file.
  845.     SaveData file_name, dlgFile.FileTitle
  846. End Sub
  847.  
  848.  
  849.  
  850.  
  851.  
  852. ' Insert a frame after the selected one.
  853. Private Sub mnuFrameAfter_Click()
  854.     AddFrame
  855.     SelectFrame SelectedFrame + 1
  856. End Sub
  857. ' Insert a frame before the selected one.
  858. Private Sub mnuFrameBefore_Click()
  859.     AddFrame
  860.     lblFrame.Caption = Format$(SelectedFrame) & "/" & Format$(NumFrames)
  861. End Sub
  862.  
  863. ' Remove the polylines from the selected frame.
  864. Private Sub mnuFrameClear_Click()
  865. Dim i As Integer
  866.     
  867.     With Frames(SelectedFrame)
  868.         .NumPolylines = 0
  869.         Erase .Poly
  870.     End With
  871.     
  872.     SelectFrame SelectedFrame
  873.  
  874.     DataModified = True
  875.     Caption = "TweenSmo*[" & FileTitle & "]"
  876. End Sub
  877.  
  878. ' Delete the selected frame.
  879. Private Sub mnuFrameDelete_Click()
  880. Dim i As Integer
  881.  
  882.     For i = SelectedFrame To NumFrames - 1
  883.         CopyFrame i + 1, i
  884.     Next i
  885.  
  886.     NumFrames = NumFrames - 1
  887.     ReDim Preserve Frames(1 To NumFrames)
  888.  
  889.     sbarFrame.Max = NumFrames
  890.  
  891.     If SelectedFrame > NumFrames Then _
  892.        SelectedFrame = NumFrames
  893.     SelectFrame SelectedFrame
  894.  
  895.     mnuFrameDelete.Enabled = (NumFrames > 1)
  896.     DataModified = True
  897.     Caption = "TweenSmo*[" & FileTitle & "]"
  898. End Sub
  899.  
  900. ' Select a new frame.
  901. Private Sub sbarFrame_Change()
  902.     If SelectingFrame Then Exit Sub
  903.     SelectFrame sbarFrame.Value
  904. End Sub
  905.  
  906.  
  907. ' Select a new frame.
  908. Private Sub sbarFrame_Scroll()
  909.     sbarFrame_Change
  910. End Sub
  911.